home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / PROGMISC / SUPER135.LZH / CB.PRG next >
Text File  |  1989-03-25  |  14KB  |  474 lines
  1. external helpmod
  2. set key -30 to helpmod
  3. initcol()
  4.  
  5.  
  6. *--- change to '*.NTX' if applicable
  7. defindex = '*.NDX'
  8. *---
  9.  
  10.  
  11. setcolor(C_normcol)
  12. NC = standard()
  13. ini_cap = keybd(2)
  14. CAPSLOCK(.T.)
  15. xplode = .t.
  16. SET CONFIRM OFF
  17. SET BELL OFF
  18. SET SAFETY OFF
  19. SET WRAP ON
  20. SET SCOREBOARD OFF
  21. SET TYPEAHEAD TO 100
  22. save screen to pre_cart
  23. isfopen = .f.
  24. q_ed_ok = .t.
  25. STORE '' TO cb_dbfname,cb_ndxstr,cb_ndxost,query_exp
  26. STORE 0 TO cb_recno,cb_size ,CB_IDXCT
  27. cb_order = 1
  28. private cb_dbfs[100]
  29. private cb_flds[100]
  30. private cb_ndxs[ADIR(defindex)]
  31. private cb_acndx[6]
  32. paint_cb()
  33. filton = .f.
  34.  
  35. *- MENUS
  36. LASTMENU = 4
  37. TITLES = "FILES:DATA:ENVIRONMENT:QUIT"
  38. CHOICES1 = "8:Select DBF:Pick Index(s):Modify Structure:Create Structure:Index Order:New Index:Form Letters:List Text File"
  39. CHOICES2 = "8:Build Query:Replace Fields:Print Lists:Tabular Edit:Vertical Edit:Hunt Duplicates:Create Labels:Sum/Average Field"
  40. choices3 = "2:Set Colors:Change Directory"
  41. choices4 = "1:Quit"
  42. cb_sel = 1.1
  43. *-
  44.  
  45. DO WHILE .T.
  46.    SAYQUERY()
  47.    SCROLL(21,1,23,78,0)
  48.    IF ISFOPEN
  49.      N_RECS =IIF(!EMPTY(CB_DBFNAME),' Containing '+STR(RECC())+' RECORDS','')
  50.      @21,03 say   "DBF Open          -  "+cb_dbfname+N_RECS
  51.      IF !EMPTY(CB_NDXSTR)
  52.        @22,03 say "Indices Open      -  "+cb_ndxstr
  53.        @23,03 say "Controlling Index -  "+cb_acndx[cb_order]
  54.      ENDIF
  55.    ENDIF
  56.    CB_SEL = PULLIT(CB_SEL,TITLES,choices1,choices2,choices3,choices4)
  57.    if cb_sel = 0
  58.         CB_SEL = 4.1
  59.    endif
  60.    do case
  61.           case cb_sel = 1.1
  62.             if adir('*.dbf') > 0
  63.                   cb_pickdbf()
  64.             else
  65.                   msg("No DBFs detected in this directory")
  66.             endif
  67.           case cb_sel =1.2  .and. isfopen
  68.              if adir(defindex) > 0
  69.                    cb_picknd()
  70.              endif
  71.           case cb_sel = 1.3 .or. cb_sel = 1.4
  72.                 if messyn("Datafiles will be closed while in create/modify routines","Continue","Quit",10,10)
  73.                     if cb_sel = 1.3
  74.                       if adir('*.dbf') > 0
  75.                             modiS("M")
  76.                             close data
  77.                             isfopen = .f.
  78.                       else
  79.                             msg("No DBFs detected in this directory")
  80.                       endif
  81.                     elseif cb_sel = 1.4
  82.                        MODIS("C")
  83.                        close data
  84.                        isfopen = .f.
  85.                     endif
  86.                 endif
  87.           case cb_sel = 1.5 .and. isfopen  .AND. !EMPTY(CB_NDXSTR)
  88.              cb_contin()
  89.           case cb_sel = 1.6 .and. isfopen
  90.              cb_maketi()
  91.           case cb_sel = 1.7  .and. isfopen
  92.               formletr()
  93.           case cb_sel = 1.8    && list text file
  94.               cb_listf()
  95.           CASE int(cb_sel) = 2 .and. !isfopen
  96.               MSG('A DBF must be open for the options','on this menu to be available')
  97.           case cb_sel = 2.1
  98.               query_exp = query()
  99.           case cb_sel = 2.2
  100.               GLOBREP()
  101.           case cb_sel = 2.3
  102.               tquery= prntlst(query_exp)
  103.               query_exp = tquery
  104.           case cb_sel = 2.4
  105.                 editdb(.t.)
  106.           case cb_sel = 2.5
  107.                 external FASTFORM,QUERY,PRNTLST,EDITDB,DUPLOOK,CLABEL
  108.                 private do1[7],do2[7]
  109.                 do1[1]= "Build Query"
  110.                 do1[2]= "Print Lists"
  111.                 do1[3]= "Tabular Edit   "
  112.                 do1[4]= "Hunt Duplicates"
  113.                 do1[5]= "Create Labels  "
  114.                 do1[6]= "Fast Form Letter"
  115.                 do1[7]= "Quit"
  116.                 do2[1]= "Query"
  117.                 do2[2]= "PRNTLST"
  118.                 do2[3]= "EDITDB"
  119.                 do2[4]= "DUPLOOK"
  120.                 do2[5]= "CLABEL"
  121.                 do2[6]= "FASTFORM"
  122.                 do2[7]= "      "
  123.                 doITALL(do1,do2)
  124.           case cb_sel = 2.6
  125.               duplook()
  126.           case cb_sel = 2.7
  127.               clabel()
  128.           case cb_sel = 2.8     && sum/AVERAGE
  129.               IF MESSYN("Sum or Average?","Sum","Average")
  130.                 sum_ave()
  131.               else
  132.                 sum_ave("AVE")
  133.               endif
  134.           case cb_sel = 3.1
  135.                 setcolors()
  136.                 set color to (c_normcol)
  137.                 paint_cb()
  138.           case cb_sel = 3.2  && dir
  139.                 if new_dir()
  140.                     close data
  141.                     isfopen = .f.
  142.                     query_exp=''
  143.                     paint_cb()
  144.                 endif
  145.           case cb_sel = 4.1
  146.             IF MESSYN('Are you done ?',10,10)
  147.               SET CURSOR ON
  148.               if !ini_cap
  149.                 capsloff()
  150.               endif
  151.               restore screen from pre_cart
  152.               return
  153.             endif
  154.    endcase
  155. enddo
  156.  
  157.  
  158. ***********************************************************
  159. function cb_pickdbf
  160. dbfpick = popex('*.dbf')
  161. if !empty(dbfpick)
  162.         use &DBFPICK
  163.         IF EMPTY(ALIAS())
  164.            MSG("UNABLE TO OPEN DATABASE  - POSSIBLY CORRUPT OR .DBT FILE MISSING  ")
  165.            RETURN ''
  166.         ENDIF
  167.         isfopen = .t.
  168.         QUERY_EXP = ''
  169.         cb_dbfname = dbfpick
  170.         cb_size = fcount()
  171.         PUBLIC cb_flds[fcount()]
  172.         afields(cb_flds)
  173.         FOR DE = 1 TO 6
  174.           ADEL(cb_acndx,DE)
  175.         NEXT
  176.         CB_NDXSTR=''
  177. endif
  178. return ''
  179. *******************************************************************
  180. function cb_picknd
  181. declare cb_ndxs[ADIR(defindex)]
  182. FOR DE = 1 TO 6
  183.   ADEL(cb_acndx,DE)
  184. NEXT
  185. ADIR(defindex,CB_NDXS)
  186. pick_ndx()        && get a list of active indices into cb_acndx
  187. cb_openem()
  188. return ''
  189.  
  190. *****************************************************************************
  191. function cb_contin
  192. private old_o
  193. old_o = cb_order
  194. cb_order = mchoice('cb_acndx',10,10,20,50)
  195. if cb_order = 0
  196.       cb_order = old_o
  197. else
  198.       set order to (cb_order)
  199. endif
  200. return ''
  201. *****************************************************************************
  202. function cb_maketi      && make temp ndx
  203. private newstr
  204.  
  205. MAKEWIND('arr',4,7,18,47)
  206. makewind('show',20,7,23,78)
  207. @4,8 say  "[ Select field(s) to index on ]"
  208. @18,8 say "[ Escape when done            ]"
  209. @20,8 say "[ Index key expression        ]"
  210. cb_el = 1
  211. cb_makei = ''
  212. newstr = ''
  213. DO WHILE .T.
  214.    @21,8 say subst(cb_makei,1,50)
  215.    @21,8 say subst(cb_makei,50,100)
  216.    retstr =  ACHOICE(5,8,17,36,cb_FLDS,'','',cb_el)
  217.    cb_el = retstr
  218.    IF retstr = 0
  219.       EXIT
  220.    ENDI
  221.    c_fld = cb_flds[cb_el]
  222.    cb_type = type(c_fld)
  223.    do case
  224.         case cb_type = 'C'
  225.                 newstr = c_fld
  226.         case cb_type = 'D'
  227.                 newstr = 'dtos('+c_fld+')'
  228.         case cb_type = 'N'
  229.                 newstr = 'nbr2str('+c_fld+')'
  230.         case cb_type = 'L'
  231.                 newstr = 'iif('+c_fld+',"T","F")'
  232.         case cb_type = 'M'
  233.                 newstr = ''
  234.    endcase
  235.    if !empty(newstr)
  236.      cb_makei = cb_makei+newstr+'+'
  237.    endif
  238. ENDD
  239. if !empty(newstr)
  240.  if  messyn("Create this index now ? ",10,10)
  241.    cb_makei= left(cb_makei,len(cb_makei)-1)  && get rid of last '+'
  242.    inname = space(12)
  243.    do while .t.
  244.      one_read("Name of index: ["+defindex+"]  ",'inname','@!')
  245.      IF !(right(defindex,4) $ INNAME)
  246.         MSG('USE FORMAT : ['+defindex+']')
  247.         LOOP
  248.      ENDIF
  249.      if file(inname)
  250.         if messyn("That index exists - overwrite ?")
  251.                 exit
  252.         endif
  253.      elseif empty(inname)
  254.         if messyn("You've left the name blank - abort ?")
  255.                 exit
  256.         endif
  257.      else
  258.         exit
  259.      endif
  260.    enddo
  261.    if !empty(inname)
  262.      plswait(.t.)
  263.      index on &cb_makei to &inname
  264.      plswait(.f.)
  265.      AINS(cb_acndx,1)
  266.      CB_ACNDX[1] = ALLTRIM(INNAME)
  267.      cb_openem()
  268.      cb_order = 1
  269.    endif
  270.  endif
  271. endif
  272. killwind('show',20,7,23,78)
  273. KILLWIND('arr',4,7,18,47)
  274.  
  275. ************************************************************************
  276. function cb_openem
  277.  
  278. cb_ndxstr = ''
  279. KNT = ALENGTH(CB_ACNDX)
  280. FOR ID = 1 TO KNT
  281.         IDS = STR(ID,1)
  282.         IF TYPE('CB_ACNDX[ID]') ='C'
  283.                 ID&IDS = CB_ACNDX[ID]
  284.                 CB_NDXSTR = CB_NDXSTR+CB_ACNDX[ID]+','
  285.         ENDIF
  286. NEXT
  287. CB_IDXCT = KNT
  288. CB_ORDER = KNT
  289. do case
  290.         case KNT = 6
  291.                 set index to &id1,&id2,&id3,&id4,&id5,&id6
  292.         case KNT = 5
  293.                 set index to &id1,&id2,&id3,&id4,&id5
  294.         case KNT = 4
  295.                 set index to &id1,&id2,&id3,&id4
  296.         case KNT = 3
  297.                 set index to &id1,&id2,&id3
  298.         case KNT = 2
  299.                 set index to &id1,&id2
  300.         case KNT = 1
  301.                 set index to &id1
  302. endcase
  303. return ''
  304.  
  305. ******************************************************************************
  306. FUNCTION CB_RFLD        && REPLACE SELECTED FIELDS
  307. MAKEWIND('RFLD',10,10,20,50,C_POPcol)
  308. cb_repf = ''
  309. do while .t.
  310.     @11,12 SAY IIF(EMPTY(query_exp),"No Query Active","Query Active")
  311.     @13,12 prompt "Select Field to Replace"+' '+cb_repf+space(5)
  312.     @14,12 prompt "Replace Selected Field"+' '+cb_repf+space(5)
  313.     @15,12 prompt "Quit"
  314.     menu to rep_what
  315.     do case
  316.         case rep_what = 1
  317.                 cb_repp = mchoice('cb_flds',12,12,22,25)
  318.                 if cb_repp > 0
  319.                   cb_repf = cb_flds[cb_repp]
  320.                 endif
  321.         case rep_what = 2 .and. !empty(cb_repf)
  322.                 len_var = 0
  323.                 typ_var = ""
  324.                 mvar = cb_mvar(cb_repf)
  325.                 if !empty(typ_var)
  326.                    SAVE SCREEN TO PRE_GET
  327.                    bot = max( 45, min(78,len_var+5) )
  328.                    makewind('repv',5,5,8,bot)
  329.                    SET CONFIRM ON
  330.                    @6,7 say "Replace "+cb_repf+" with what value : "
  331.                    @7,7 get mvar
  332.                    read
  333.                    SET CONFIRM OFF
  334.                    RESTORE SCREEN FROM PRE_GET
  335.                    killwind('repv',5,5,8,bot)
  336.                 endif
  337.                 CB_USEQ = .F.
  338.                   if !empty(query_exp)
  339.                         cb_useq = messyn("Replace for Query Condition ? ",10,10)
  340.                   endif
  341.                   if messyn("Execute Replace ? ",10,10)
  342.                         if !empty(query_exp) .and. cb_useq
  343.                                 replace all &cb_repf with mvar for &query_exp
  344.                         else
  345.                                 replace all &cb_repf with mvar
  346.                         endif
  347.                   endif
  348.         case rep_what = 3 .or. rep_what = 0
  349.                 exit
  350.     endcase
  351. enddo
  352. KILLWIND('RFLD',10,10,20,50,C_POPcol)
  353.  
  354. ******************************************************************************
  355.  
  356. function cb_mvar
  357. para nameofld
  358. DO CASE
  359. CASE type(nameofld) = "C"
  360.    ret_var = SPACE(len(&nameofld))
  361.    len_var = len(&nameofld)
  362.    typ_var = "C"
  363. CASE type(nameofld) = "N"
  364.    ret_var = 0
  365.    len_var = len(str(&nameofld))
  366.    typ_var = "N"
  367. CASE type(nameofld) = "D"
  368.    ret_var =ctod('  /  /  ')
  369.    len_var = 8
  370.    typ_var = "D"
  371. CASE type(nameofld) = "L"
  372.    ret_var = SPACE(1)
  373.    len_var = 1
  374.    typ_var = "L"
  375. ENDCASE
  376. return ret_var
  377.  
  378.  
  379. ******************************************************************************
  380. ******************************************************************************
  381. function nbr2str
  382. para nbr
  383. rnbr = STR(1000000+NBR)
  384. return rnbr
  385. ******************************************************************************
  386. function pick_ndx
  387. MAKEWIND('w_arr',1,20,17,50,C_NORMCOL)
  388. private tempid[adir(defindex)]
  389. ACOPY(cb_ndxs,tempid)
  390. @1,22 say  "[Select/Deselect Indices]"
  391. @17,22 say "[Press ESC when done   ]"
  392. nextndx= 1
  393. PR_EL = 1
  394. DO WHILE .T.
  395.    pr_el =  ACHOICE(2,21,16,49,tempid,'','',pr_el)
  396.    IF pr_el = 0
  397.       EXIT
  398.    ENDI
  399.    if left(tempid[pr_el],2)<>" "
  400.        n_name = cb_ndxs[pr_el]
  401.        key = ALLTRIM(nkey(n_name))
  402.        if testcond(key,"C")     && see if the index key will evaluate w/out
  403.                                 && errors in the current environment
  404.          tempid[pr_el] = ' '+tempid[pr_el]
  405.          cb_acndx[nextNDX]   = cb_ndxs[pr_el]
  406.          nextndx = nextndx+ 1
  407.        else
  408.          msg("That index either does not match the DBF","or this program does not support a function","in the index expression")
  409.          msg("For your info, the index expression is:",key)
  410.        endif
  411.    ELSE
  412.        tempid[pr_el] = subst(tempid[pr_el],3)
  413.        takeout = ascan(cb_acndx,tempid[pr_el])
  414.        adel(cb_acndx,takeout)
  415.        nextndx= nextndx- 1
  416.    ENDIF
  417. ENDDO
  418.  
  419. KILLWIND('w_arr',1,20,17,50)
  420. return ''
  421.  
  422.  
  423. ******************************************************************************
  424. function paint_cb
  425. CLS()
  426. BXX(1,0,24,79)
  427. BXX(16,00,20,79)
  428. bXx(20,00,24,79)
  429. ATT(2,1,15,78,STANDARD(),CHR(177))
  430.  
  431. @16,0 say '├'
  432. @20,0 say '├'
  433. @16,79 say '┤'
  434. @20,79 say '┤'
  435. @20,70 say '─'
  436. @20,2 say '[Datafile]'
  437. @16,2 say '[Query]'
  438. @24,2 say '[Drive and Directory   '+curdir()+']'
  439. BXX(8,20,11,59)
  440. @09,22 say  "D A T A  F I L E    H A N D L E R"
  441. @10,34 say  "VERSION 2.0"
  442. SCROLL(0,1,0,78,0)
  443. return ''
  444.  
  445. FUNCTION SAYQUERY
  446. SCROLL(17,1,19,78,0)
  447. @17,3 say SUBST(QUERY_EXP,1,70)
  448. @18,3 say SUBST(QUERY_EXP,71,70)
  449. @19,3 say SUBST(QUERY_EXP,141,70)
  450. RETURN ''
  451.  
  452. Function cb_listf
  453. private lstf
  454. lstf = space(12)
  455. one_read("File to list (ENTER or *Wildcards for picklist - ESC to exit)","lstf","")
  456. if lastkey() = 27
  457.    return ''
  458. endif
  459. if empty(lstf) .or. at('*',lstf) > 0
  460.    if empty(lstf)
  461.            lstf = "*.*"
  462.    endif
  463.    lstf = popex(lstf)
  464. endif
  465. if lastkey() = 27
  466.    return ''
  467. endif
  468. if file(lstf)
  469.      fileread(1,1,23,79,lstf)
  470. endif
  471.  
  472.  
  473.  
  474.